module BfParse (runParse) where
import Common
import Text.ParserCombinators.Parsec

data BfOp = PMove Offset | PMod Int | POut | PIn | PBlock [BfOp] 
 deriving (Show, Eq)

clean n = do many (noneOf "[],.+-<>")
             ret <- n
             many (noneOf "[],.+-<>")
             return ret

plusminus :: (Char,Char) -> Parser Int 
plusminus (l,r) = 
  (many1 . clean . oneOf) [l,r] >>=  return . sum . map (\x -> if x == l then (-1) else 1)
                        
moveL, modU, outO, inO, block, single :: Parser BfOp
moveL = return . PMove =<< plusminus ('<','>')         
modU  = return . PMod  =<< plusminus ('-','+')
outO  = clean (char '.') >> return POut
inO   = clean (char ',') >> return PIn
block = do clean (char '[')
           inner <- parseBF
           clean (char ']')
           return (PBlock inner)
single = choice (map try [moveL, modU, outO, inO, block])

parseBF :: Parser [BfOp]
parseBF = many1 single

runParse :: String -> Either String [Operation]
runParse txt = 
      case parse parseBF "" txt of
       Left err -> Left (show err)
       Right x -> Right (transform x)

transform :: [BfOp] -> [Operation]
transform ((PBlock [PMod _]):(PMod n):xs) = (0 :<- n): transform xs
transform ((PBlock [PMod _]):xs) = (0 :<- 0): transform xs
transform ((PBlock blk):xs) = LoopOp While (transform blk) : transform xs
transform ((PMove a):(PMod m):(PMove b):xs) 
 | (a+b) /= 0 = (a :+= m):transform ((PMove (a+b)):xs) 
 | otherwise  = (a :+= m):transform xs 
transform ((PMod m):xs) = (0 :+= m) : transform xs
transform (POut:xs) = PutcOp (Ptr 0) : transform xs
transform (PIn:xs) = GetcOp : transform xs
transform ((PMove m):xs) = (MoveOp m) : transform xs
transform [] = []
